#!/usr/bin/perl

=head1 NAME

marc_merge_vufind.pl

=d1 NAMEhead2 AUTHOR

Paul Johnson, August 2010, with changes by Chris Keene, 2011

=head1 SYNOPSIS

Merges MARC records into a Solr database.

=head1 USAGE

Usage:

marc_merge_vufind.pl infile outfile institution_code

e.g. marc_merge_vufind.pl marcfile.mrc loadfile.mrc SU

The merger process:

1. Empty the VuFind SOLR indexes (i.e. remove /usr/local/vufind/solr/biblio/index)
2. Run this script against the first file
3. Import the first file into SOLR
4. Run the script against additional file
5. Import the additional file into SOLR

The script will:

- Extract an ISBN/ISSN, add it to 001 (in 13-digit format for ISBNs)
  If there is no ISBN/ISSN, it will retain the existing 001, but prefix it with the institution code (so there is no  conflict of numbers from different sources)

- Add the incoming system number into a 969 field, in the form $aInstitution code $bInstitution code & System number (e.g. 969 $aSU $bSU12345)

- Attempt to find a record with the extracted ISN on SOLR. If present, it will :
    > extract the record
    > decide whether to retain the existing or incoming record
    > merge chosen fields into the chosen record from the other one. Merged fields have an institution identifier added (in $a or $5, depending on the field).

- Write the record to the output file.

N.B. This version of the script gives preference to Swansea University (SU) records when merging. It also contains some special stuff for Carmarthen's (TSDC) Horizon records, because they don't have an 001 field.

=cut

use MARC::Batch;
use MARC::Record;
use MARC::Field;
use LWP::Simple;
use Business::ISBN;
use bytes;
use utf8;
# following are used to avoid problems with MARC import and special chars
use Encode qw(encode decode);
use open qw( :std :utf8);
use IO::File;


## commented out to try alternative code to handle records with unusal characters.
#my $batch1 = MARC::Batch->new("USMARC","$ARGV[0]");
#$batch1->strict_off();

## CJK alternative code to handle unsual characters in marc records
# don't let MARC::Batch open the file, as it applies the ':utf8' IO layer 
my $fh = IO::File->new($ARGV[0]);  
$batch1 = MARC::Batch->new( 'USMARC', $fh );
#$batch1->warnings_off();
$batch1->strict_off();



open (MARCOUT,">$ARGV[1]") or die "Can't open outout file $ARGV[1]";
open (DIAGOUT,">diag.mrc") or die "Can't open DIAG file";

$source_system = $ARGV[2] or die "no system id provided (eg susx brighton). ";
$addcr = $ARGV[3];

my %charconv = (
     "#00;"  => "\x00",
     "#01;"  => "\x01",
     "#02;"  => "\x02",
     "#03;"  => "\x03",
     "#04;"  => "\x04",
     "#05;"  => "\x05",
     "#06;"  => "\x06",
     "#07;"  => "\x07",
     "#08;"  => "\x08",
     "#09;"  => "\x09",
     "#10;"  => "\x0A",
     "#11;"  => "\x0B",
     "#12;"  => "\x0C",
     "#13;"  => "\x0D",
     "#14;"  => "\x0E",
     "#15;"  => "\x0F",
     "#16;"  => "\x10",
     "#17;"  => "\x11",
     "#18;"  => "\x12",
     "#19;"  => "\x13",
     "#20;"  => "\x14",
     "#21;"  => "\x15",
     "#22;"  => "\x16",
     "#23;"  => "\x17",
     "#24;"  => "\x18",
     "#25;"  => "\x19",
     "#26;"  => "\x1A",
     "#27;"  => "\x1B",
     "#28;"  => "\x1C",
     "#29;"  => "\x1D",
     "#30;"  => "\x1E",
     "#31;"  => "\x1F",
     "#32;"  => "\x20",
     "#33;"  => "\x21",
     "#34;"  => "\x22",
     "#35;"  => "\x23",
     "#36;"  => "\x24",
     "#37;"  => "\x25",
     "#38;"  => "\x26",
     "#39;"  => "\x27",
     "#40;"  => "\x28",
     "#41;"  => "\x29",
     "#42;"  => "\x2A",
     "#43;"  => "\x2B",
     "#44;"  => "\x2C",
     "#45;"  => "\x2D",
     "#46;"  => "\x2E",
     "#47;"  => "\x2F",
     "#48;"  => "\x30",
     "#49;"  => "\x31",
     "#50;"  => "\x32",
     "#51;"  => "\x33",
     "#52;"  => "\x34",
     "#53;"  => "\x35",
     "#54;"  => "\x36",
     "#55;"  => "\x37",
     "#56;"  => "\x38",
     "#57;"  => "\x39",
     "#58;"  => "\x3A",
     "#59;"  => "\x3B",
     "#60;"  => "\x3C",
     "#61;"  => "\x3D",
     "#62;"  => "\x3E",
     "#63;"  => "\x3F",
     "#64;"  => "\x40",
     "#65;"  => "\x41",
     "#66;"  => "\x42",
     "#67;"  => "\x43",
     "#68;"  => "\x44",
     "#69;"  => "\x45",
     "#70;"  => "\x46",
     "#71;"  => "\x47",
     "#72;"  => "\x48",
     "#73;"  => "\x49",
     "#74;"  => "\x4A",
     "#75;"  => "\x4B",
     "#76;"  => "\x4C",
     "#77;"  => "\x4D",
     "#78;"  => "\x4E",
     "#79;"  => "\x4F",
     "#80;"  => "\x50",
     "#81;"  => "\x51",
     "#82;"  => "\x52",
     "#83;"  => "\x53",
     "#84;"  => "\x54",
     "#85;"  => "\x55",
     "#86;"  => "\x56",
     "#87;"  => "\x57",
     "#88;"  => "\x58",
     "#89;"  => "\x59",
     "#90;"  => "\x5A",
     "#91;"  => "\x5B",
     "#92;"  => "\x5C",
     "#93;"  => "\x5D",
     "#94;"  => "\x5E",
     "#95;"  => "\x5F",
     "#96;"  => "\x60",
     "#97;"  => "\x61",
     "#98;"  => "\x62",
     "#99;"  => "\x63",
     "#100;"  => "\x64",
     "#101;"  => "\x65",
     "#102;"  => "\x66",
     "#103;"  => "\x67",
     "#104;"  => "\x68",
     "#105;"  => "\x69",
     "#106;"  => "\x6A",
     "#107;"  => "\x6B",
     "#108;"  => "\x6C",
     "#109;"  => "\x6D",
     "#110;"  => "\x6E",
     "#111;"  => "\x6F",
     "#112;"  => "\x70",
     "#113;"  => "\x71",
     "#114;"  => "\x72",
     "#115;"  => "\x73",
     "#116;"  => "\x74",
     "#117;"  => "\x75",
     "#118;"  => "\x76",
     "#119;"  => "\x77",
     "#120;"  => "\x78",
     "#121;"  => "\x79",
     "#122;"  => "\x7A",
     "#123;"  => "\x7B",
     "#124;"  => "\x7C",
     "#125;"  => "\x7D",
     "#126;"  => "\x7E",
     "#127;"  => "\x7F",
     "#128;"  => "\x80",
     "#129;"  => "\x81",
     "#130;"  => "\x82",
     "#131;"  => "\x83",
     "#132;"  => "\x84",
     "#133;"  => "\x85",
     "#134;"  => "\x86",
     "#135;"  => "\x87",
     "#136;"  => "\x88",
     "#137;"  => "\x89",
     "#138;"  => "\x8A",
     "#139;"  => "\x8B",
     "#140;"  => "\x8C",
     "#141;"  => "\x8D",
     "#142;"  => "\x8E",
     "#143;"  => "\x8F",
     "#144;"  => "\x90",
     "#145;"  => "\x91",
     "#146;"  => "\x92",
     "#147;"  => "\x93",
     "#148;"  => "\x94",
     "#149;"  => "\x95",
     "#150;"  => "\x96",
     "#151;"  => "\x97",
     "#152;"  => "\x98",
     "#153;"  => "\x99",
     "#154;"  => "\x9A",
     "#155;"  => "\x9B",
     "#156;"  => "\x9C",
     "#157;"  => "\x9D",
     "#158;"  => "\x9E",
     "#159;"  => "\x9F",
     "#160;"  => "\xA0",
     "#161;"  => "\xA1",
     "#162;"  => "\xA2",
     "#163;"  => "\xA3",
     "#164;"  => "\xA4",
     "#165;"  => "\xA5",
     "#166;"  => "\xA6",
     "#167;"  => "\xA7",
     "#168;"  => "\xA8",
     "#169;"  => "\xA9",
     "#170;"  => "\xAA",
     "#171;"  => "\xAB",
     "#172;"  => "\xAC",
     "#173;"  => "\xAD",
     "#174;"  => "\xAE",
     "#175;"  => "\xAF",
     "#176;"  => "\xB0",
     "#177;"  => "\xB1",
     "#178;"  => "\xB2",
     "#179;"  => "\xB3",
     "#180;"  => "\xB4",
     "#181;"  => "\xB5",
     "#182;"  => "\xB6",
     "#183;"  => "\xB7",
     "#184;"  => "\xB8",
     "#185;"  => "\xB9",
     "#186;"  => "\xBA",
     "#187;"  => "\xBB",
     "#188;"  => "\xBC",
     "#189;"  => "\xBD",
     "#190;"  => "\xBE",
     "#191;"  => "\xBF",
     "#192;"  => "\xC0",
     "#193;"  => "\xC1",
     "#194;"  => "\xC2",
     "#195;"  => "\xC3",
     "#196;"  => "\xC4",
     "#197;"  => "\xC5",
     "#198;"  => "\xC6",
     "#199;"  => "\xC7",
     "#200;"  => "\xC8",
     "#201;"  => "\xC9",
     "#202;"  => "\xCA",
     "#203;"  => "\xCB",
     "#204;"  => "\xCC",
     "#205;"  => "\xCD",
     "#206;"  => "\xCE",
     "#207;"  => "\xCF",
     "#208;"  => "\xD0",
     "#209;"  => "\xD1",
     "#210;"  => "\xD2",
     "#211;"  => "\xD3",
     "#212;"  => "\xD4",
     "#213;"  => "\xD5",
     "#214;"  => "\xD6",
     "#215;"  => "\xD7",
     "#216;"  => "\xD8",
     "#217;"  => "\xD9",
     "#218;"  => "\xDA",
     "#219;"  => "\xDB",
     "#220;"  => "\xDC",
     "#221;"  => "\xDD",
     "#222;"  => "\xDE",
     "#223;"  => "\xDF",
     "#224;"  => "\xE0",
     "#225;"  => "\xE1",
     "#226;"  => "\xE2",
     "#227;"  => "\xE3",
     "#228;"  => "\xE4",
     "#229;"  => "\xE5",
     "#230;"  => "\xE6",
     "#231;"  => "\xE7",
     "#232;"  => "\xE8",
     "#233;"  => "\xE9",
     "#234;"  => "\xEA",
     "#235;"  => "\xEB",
     "#236;"  => "\xEC",
     "#237;"  => "\xED",
     "#238;"  => "\xEE",
     "#239;"  => "\xEF",
     "#240;"  => "\xF0",
     "#241;"  => "\xF1",
     "#242;"  => "\xF2",
     "#243;"  => "\xF3",
     "#244;"  => "\xF4",
     "#245;"  => "\xF5",
     "#246;"  => "\xF6",
     "#247;"  => "\xF7",
     "#248;"  => "\xF8",
     "#249;"  => "\xF9",
     "#250;"  => "\xFA",
     "#251;"  => "\xFB",
     "#252;"  => "\xFC",
     "#253;"  => "\xFD",
     "#254;"  => "\xFE",
     "#255;"  => "\xFF",
     "&lt;"   => "\x3c",
     "&gt;"   => "\x3e",
     "&amp;"  => "&"
);

# fields to be retained in MARC records


sub trim_isn($)
# removes hyphens and ignores stuff at the end of an ISBN subfield
{
  my $isbn = shift;
  my $newisbn = "";

  for ($pos = 0; $pos <= length($isbn); $pos++) 
  {
    $curchar = substr($isbn,$pos,1);
    if ($curchar =~ m/[0-9Xx]/)
    {
      $newisbn = $newisbn.$curchar;
    } else 
    {
      if ($curchar ne "-") 
      {   
        return $newisbn;
      }
    }
  }
    return $newisbn;
}


sub sort_cnums()
{
    $field001 = $record1->field('001');
    if ($field001 eq "") {
      # not sure if this code ever called?
      $cnum = "NN".$source_system.$dumnum;
      $new001 = MARC::Field->new('001',$cnum);
      print "Local number only $cnum\n";
      $record1->insert_fields_ordered($new001);
      $field001 = $record1->field('001');
      $dumnum++;
    } else {
      $cnum = $field001->data();
    }


  # get the local control number
  if (substr($cnum,0,2) eq "NN") {
    $lnum = $cnum;
  } else {
    $lnum = $source_system.$cnum;
  }
  $localnumfield = MARC::Field->new('969','','','a' => $source_system, 'b' => $lnum);
  

  # get the sbn from the file record, or ssn if no sbn

  $isn = "";

  $isn = $record1->subfield('020',"a");

  if ($isn eq "") 
  { 
    $isn = $record1->subfield('022',"a");
  }
  if ($isn eq "")
  {
    # subfield y is actually for incorrect issn, but the sfx marc21 records seem to have
    # correct issns in their.
    $isn = $record1->subfield('022',"y");
  }

  $isn = trim_isn($isn);

  if (length($isn) == 10) 
  {
    $isbn_valid = 1;
    for ($pos = 0; $pos < 10; $pos++) 
    {
      $curchar = substr($isn,$pos,1);
      if ($curchar !~ m/[0-9]/)
      { 
         $isbn_valid = 0;
      }
    }

    if ($isbn_valid) 
    {
      $isbn10 = Business::ISBN->new($isn);
      $isbn13 = $isbn10->as_isbn13;
      $isn = $isbn13->as_string([]);
    }
  }

  if ($isn ne "") 
  {
    #replace the 001 with the isn (13 digit)
    $field001->update($isn);
    #first remove existing 001 to avoid dup
    #my @delete001 = $record1->field('001');
    #$record1->delete_fields(@delete001);
    #$new001 = MARC::Field->new('001',$isn);
    #$record1->insert_fields_ordered($new001);
  } else 
  {
    $isn = $lnum;
    $field001->update($isn);

  }

  #print "isn $isn lnum $lnum \n";

}


 my $fieldname = "fullrecord\">";
 my $fieldend = "#29";
 my $records_in = 0;
 my $records_out = 0;
 my $records_matched = 0;
 my $dumnum = 1;

## CJK commented out to use alternative code
# read a record from the file
#while ($record1 = $batch1->next()) {

## CJK alternative code to handle unusal characters
## loops continuiously calling for the next record
## if it finds a bad record (which we only know when it's too late, and normally
## it would result in the perl script crashing) it doesn't crash, but "sort of"
## calls an exception. The exception calls the orignal never ending loop again. 
## Yes. This probably sucks.
RECORD: while (  ) {
    # get records
    eval { $record1 = $batch1->next() };
    if ( $@ ) {
        print "Bad MARC record: skipped $i $records_in \n";
        next;
    }
last unless ( $record1 );
# end of code which handles special characters

 #print DIAGOUT $record1->as_usmarc,"\n";

  my @fieldsToInsert = ();
  my @mdbkeepfields = ();
  my $marcdb = "";
  my @allrec1fields = ();
  my $newrec = "";
  my $dbsysmatch = "";

  $records_in++;
  # print out every 1000 number
  if ($records_in % 1000 == 0) { print "Record $records_in\n"; } 
  #print "$records_in\n";

# get the system control number
  sort_cnums();

  # see if there is a matching record on the database

  $dbrecord = 0;

  my $url = "http://localhost:17080/solr/biblio/select/?q=id:".
       $isn."&omitHeader&fl=fullrecord&version=2.2&start=0&rows=10&indent=off";
  #print "isn is " . $isn . "\n";

  my $content = get $url;
  #print " url $url \n"; 
  #print "content is $content \n\n";

  $source_present = 0;

  # Do we have a record already in SOLR?
  if (index($content,"numFound=\"0\"") == -1) {
    $dbrecord = 1;
  } 
  else {
   # there's a chance that the id we are using is a bibid with no 
   # institution on the front of it, yet the 'isn' we are using above
   # can have a instituion code on the front, if there is no isbn.
   # so lets try and check again 
   # TODO
   $url = "http://localhost:17080/solr/biblio/select/?q=id:".
       $cnum."&omitHeader&fl=fullrecord&version=2.2&start=0&rows=10&indent=off";
   $content = get $url;
   if (index($content,"numFound=\"0\"") == -1) {
     #$dbrecord = 1;
     print "matched on cnum $cnum \n";
   }
 
  }


  # If we have a record, then tidy it up and put it into $marcdb object
  if ($dbrecord == 1) {
    $records_matched++;

    # get the marc record out of there
    my $dbmarc = substr($content,index($content, $fieldname)+12);
    $dbmarc = substr($dbmarc,0,index($dbmarc, $fieldend)+4);

    # fix characters if necessary
    while ( my ($key, $value) = each(%charconv) ) {
      $dbmarc =~ s/$key/$value/g;
    }

    # Put the record into a Perl MARC::Record object
    $marcdb = MARC::Record->new_from_usmarc($dbmarc);

    # IF the existing MARC record already has this institutions code in the 969
    # then we might as well just skip this whole record, as it's already in the solr db
    my @fields969 = $marcdb->field('969');
    foreach my $field969 (@fields969) {
       if ($field969->subfield('a') eq $source_system) {
         #print $field969->as_string();
	 $dbsysmatch=1;
	 next;
       }
    }

  }
  else { print "$records_in NO solr db match, this is a new record. \n"; }

# IF record is in solr with this system already, just move to next record, don't output record
if ($dbsysmatch) {
  $dbsysmatch=0;
  #print "$records_in skipping as we already have a solr entry which for this record at this library\n";
  next;
}
print "$records_in being processed (not in solr db for this library) $cnum $isn\n";


# Get all local fields from the incoming record (i.e. those which are to be retained in the merged record)

  @allrec1fields = $record1->fields();

# 852 and 866 fields are treated differently from others 

  foreach (@allrec1fields) {
    my $newfield = "";
    if ($_->tag() =~ m/852/) {
      my @subfsplit = $_->subfields();
      my $numsubfields = @subfsplit;        
      $subf8 = $_->subfield('8');
      if ($subf8 ne "") {
        $newfield = MARC::Field->new( $_->tag(), $_->indicator(1), $_->indicator(2), '8' => $subf8, 'a' =>
        $source_system );
      } else {
        $newfield = MARC::Field->new( $_->tag(), $_->indicator(1), $_->indicator(2), 'a' => $source_system );
      }
      for ($i = 0; $i < $numsubfields; $i++) {
        if (($subfsplit[$i][0] ne 'a') && ($subfsplit[$i][0] ne '8')) {
          $newfield->add_subfields($subfsplit[$i][0] => $subfsplit[$i][1]);
        }
      }
      if ($numsubfields > 1) {
        push(@fieldsToInsert,$newfield);
      }
    }
    if ($_->tag() =~ m/866/) {
      my @subfsplit = $_->subfields();
      my $numsubfields = @subfsplit;        
      $subf8 = $_->subfield('8');
      if ($subf8 ne "") {
        $newfield = MARC::Field->new( $_->tag(), $_->indicator(1), $_->indicator(2), '8' => $subf8 );
      }
      for ($i = 0; $i < $numsubfields; $i++) {
        if (($subfsplit[$i][0] ne '5') && ($subfsplit[$i][0] ne '8')) {
          if ($newfield eq "") {
            $newfield = MARC::Field->new( $_->tag(), $_->indicator(1), $_->indicator(2), $subfsplit[$i][0] =>
            $subfsplit[$i][1] );
          } else {
            $newfield->add_subfields($subfsplit[$i][0] => $subfsplit[$i][1]);
          }
        }
      }
      $newfield->add_subfields('5' => $source_system);
      push(@fieldsToInsert,$newfield);
    }

# Other mergable fields have $5 with the institution code added

    if ($_->tag() =~ m/509|856/) {
      $newfield = $_->clone();
      $idsubf = $_->subfield('5');
      if ($idsubf eq "") {
        $newfield->add_subfields('5' => $source_system);
      }
      push(@fieldsToInsert,$newfield);
    }

  }

# Get all local fields from the database record, if we have one
 
 if ($dbrecord == 1) {
   @allmdbfields = $marcdb->fields();

    foreach (@allmdbfields) {
      $keepthis = 1;
      if ($_->tag() =~ m/509|852|856|866/) {
        if ($_->tag() =~ m/852/) {
          $instsubf = $_->subfield('a');
          if ($instsubf eq $source_system) {
            $keepthis = 0;
          }
        } else {
          $instsubf = $_->subfield('5');
          if ($instsubf eq $source_system) {
            $keepthis = 0;
          }
        }
        if ($keepthis == 1) {
          push(@mdbkeepfields,$_);
        }
      }
    }
  }


# This next bit does...
#... we live in a free an equal society first (record) come first served up here.

# if no database record for this marc record, use the marc record, otherwise, use the db record
  if (!$dbrecord) {
	print "this is a new record, and no db entry for it, use the import version\n";
    $chosen_record = $record1->clone();
  } else {
    print "$records_in Record already in solr, for another library, we'll use that\n";  
    if ($source_system eq "susx") {
      #$chosen_record = $record1->clone();
      $chosen_record = $marcdb->clone();
    } else {
       $chosen_record = $marcdb->clone();

    }
  }

# apropose to nothing, lets print out the title if it's a new record. 
  if (!$dbrecord) {
    print $records_in . " " . $record1->title() . "$cnum $isn\n";
  }

# Now construct the new record
  @allchosenfields = $chosen_record->fields();
  my $newrec = MARC::Record->new();
  my $recleader = $chosen_record->leader();
  $newrec->leader($recleader);

  my @allchosenfields = reverse(@allchosenfields);
  foreach (@allchosenfields) {
    if ($_->tag() !~ m/509|852|856|866/) {
      $newrec->insert_fields_ordered($_);   
    }
  }

  my @fieldsToInsert = reverse(@fieldsToInsert);
  foreach (@fieldsToInsert) {
      $newrec->insert_fields_ordered($_);
  }

  if ($dbrecord) {
    foreach (@mdbkeepfields) {
        $newrec->insert_fields_ordered($_);
    }
  }

  if ($source_present == 0) {
      $newrec->insert_fields_ordered($localnumfield);
  }

  print MARCOUT $newrec->as_usmarc;

  if ($addcr == 1) { print DIAGOUT $newrec->as_usmarc,"\n"; }
  $records_out++;
}

print "Records in:       $records_in\n";
print "Records out:      $records_out\n";
print "Records matched:  $records_matched\n";

